CD Actual 3/CD ACTUAL 3.iso/linux/incoming/jstools-.6v3/jstools-/jstools-tk3.6v3.0/lib/jprefs.tcl

Text File | 1995-02-09 | 5.2 KB | 175 lines

# jprefs.tcl - utilities for user preferences and configuration
#
# Copyright 1992-1994 by Jay Sekora.  All rights reserved, except
# that this file may be freely redistributed in whole or in part
# for non¡profit, noncommercial use.
######################################################################

### TO DO

######################################################################
# global variables:
#
global J_PREFS env
if {! [info exists J_PREFS(autoposition)]} {set J_PREFS(autoposition) 0}
if {! [info exists J_PREFS(confirm)]} {set J_PREFS(confirm) 1}
#
######################################################################


######################################################################
# j:source_config ?options? file - read user configuration from a file
#   option is -directory
# file is assumed to be in env(HOME)/.tk unless dir is specified
# NOTE: this can also be used just to source an arbitrary Tcl file
######################################################################

proc j:source_config { args } {
  j:parse_args { {directory {} } }

  set file [lindex $args 0]
  global env

  if {$directory == {}} then {
    set directory $env(HOME)/.tk
  }

  if {[file isfile "$directory/$file"]} then {
    uplevel 1 "source $directory/$file"
  }
}

######################################################################
# j:read_prefs ?options? defaults - read X defaults from file, set array
# options are:
#   -file (default defaults)
#   -directory (default ~/.tk)
#   -array (default J_PREFS)
#   -prefix (default "")
# <defaults> is a list of two-element sublists.  the first element of
#   each sublist is the name of the default (in the file and in the
#   $array array); the second is the value to use if no such default
#   exists (ie, the hardwired application default)
# If a _default_ is "tk_strictMotif", it sets the element of $array,
#   but also the global tk_strictMotif variable
# If -prefix is non-null, it (plus a comma) is prepended to each
#   preference name, so that for instance you can set -prefix to
#   "friend" and access preferences (and array indices) like
#   "friend,name", "friend,age", etc.
######################################################################

proc j:read_prefs { args } {
  j:parse_args {
    {array J_PREFS}
    {prefix {}}
    {directory {} }
    {file defaults}
  }
  set defaults [lindex $args 0]

  global env tk_strictMotif $array

  if {"x$directory" == "x"} {
    set directory $env(HOME)/.tk    ;# NOTE: created if necessary!
  }

  if {"x$prefix" != "x"} {        ;# if prefix is non-null...
    set prefix "$prefix,"        ;# ...add a comma to it
  }

  set [format {%s(0)} $array] 1        ;# dummy to make sure it's an array

  catch {option readfile $directory/$file userDefault}

  foreach pair $defaults {
    set pref_name [lindex $pair 0]
    set hard_default [lindex $pair 1]

    set value [option get . $prefix$pref_name {}]
    if {"x$value" == "x"} {set value $hard_default}
    set [format {%s(%s)} $array $prefix$pref_name] $value

    if {"x$pref_name" == "xtk_strictMotif"} {
      set tk_strictMotif $value
    }
  }
}

######################################################################
# j:read_global_prefs - read common jstools preferences from ~/.tk/defaults
######################################################################

proc j:read_global_prefs {} {
  global J_PREFS

  j:read_prefs {
    {autoposition 0}
    {bindings basic}
    {typeover 1}
    {confirm 1}
    {visiblebell 1}
    {audiblebell 1}
    {printer lp}
    {scrollbarside right}
    {j_fs_fast 0}
    {tk_strictMotif 0}
  }
}

# alias for backwards-compatibility:
proc j:read_standard_prefs {} [info body j:read_global_prefs]

######################################################################
# j:write_prefs ?options? - write X defaults to file from array
# options are:
#   -file (default defaults)
#   -directory (default ~/.tk)
#   -array (default J_PREFS)
#   -prefix (default "")
# writes all elements of array $array
# If -prefix is null, writes all elements of array $array which
#   don't have a comma in their names.
# If -prefix is non-null, writes all elements of array $array whose
#   names start with "$prefix,"
# For instance you can set -prefix to "friend" and access preferences
#   (and array indices) like "friend,name", "friend,age", etc.
######################################################################

proc j:write_prefs { args } {
  j:parse_args {
    {array J_PREFS}
    {prefix ""}
    {directory {} }
    {file defaults}
  }
  global env $array

  if {"x$directory" == "x"} then {
    set directory $env(HOME)/.tk    ;# NOTE: created if necessary!
  }

  if {! [file isdirectory $directory]} {;# make sure directory exists
    exec mkdir $directory
  }
  set f [open $directory/$file {w}]

  if {"x$prefix" == "x"} {        ;# just names with no comma
    foreach pref_name [lsort [array names $array]] {
      if {[string first , $pref_name] == -1} {
        set value [set [format {%s(%s)} $array $pref_name]]
        puts $f "*${pref_name}:\t${value}"
      }
    }
  } else {
    foreach pref_name [lsort [array names $array]] {
      if [string match "$prefix,*" $pref_name] {
        set value [set [format {%s(%s)} $array $pref_name]]
        puts $f "*${pref_name}:\t${value}"
      }
    }
  }

  close $f
  return 0
}